Internet Info 1993

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1993 / Internet Info CD-ROM (Walnut Creek) (1993).iso / networking / terms / kermit / d / picpr.bas < prev next >

Wrap

BASIC Source File | 1989-08-20 | 70.1 KB | 2,155 lines

DKPARSE 001 SUBROUTINE (token,COM.index) 002 *PARSE a symbol table for a minimally unique (U/L case) token match 003 *6/25/87 JF3 0.3.0 004 * 005 COM P(64),index(3);EQU a TO index(1),v TO index(2),s TO index(3) 006 s=0;i=1;LOOP WHILE index(i) DO i=i+1 REPEAT 007 t.len=LEN(token);check.unique=0;3 LOOP 008 index(i)=index(i)+1 009 SYM=FIELD(P(COM.index)<a,v,s>," ",1) 010 UNTIL SYM="" DO 011 c=1;LOOP T=token[c,1] UNTIL T="" DO 012 S=SEQ(T);IF 97<=S AND S<=122 THEN T=CHAR(S-32) 013 IF T=SYM[c,1] THEN c=c+1 ELSE 014 IF check.unique THEN GO 7 ELSE GO 6 015 END 016 REPEAT;IF check.unique THEN GO 8 ELSE SYM1=SYM;ix=index(i);check.unique=1 017 6 REPEAT;IF check.unique THEN 018 7 token=SYM1;index(i)=ix 019 END ELSE 020 8 index(i)=0 021 END;9 RETURN 022 * * * * * Interface info * * * * * 023 *Entry: token := char. string for search. 024 * c := index of COM variable containing dynamic array 025 * of symbol data. Each element must begin 026 * with a symbol in all caps terminated 027 * by a space; additional data may follow. 028 * a := attr# wherein to restrict match search. 029 * Zero means search by attributes. 030 * v := value# as above but values. 031 * s := Set to zero. 032 * 033 *Exit: token := Symbol that matched; unchanged otherwise. 034 * c := unchanged 035 * a := attr# where token match found; zero if not found. 036 * v := value# where found. 037 * s := subvalue# where found. 038 * 039 *Use: check.unique := true means check next symbol for match 040 * to determine if token is unique. 041 * * * * * Revision history * * * * * 042 *.0 - 6/25/87 JF3 043 END DKTC 001 SUBROUTINE (STATUS) 002 *Test Conversion routines 003 *6/29/87 JF3 0.3 004 * 005 COM P(64) 006 PRINT "idx":;INPUT idx 007 LOOP PRINT "cnv":;INPUT cnv UNTIL cnv="END" DO 008 LOOP 009 DEBUG 010 PRINT "arg":;INPUT arg 011 UNTIL arg="END" DO 012 CALL DKCNV(arg,cnv,idx) 013 PRINT "arg(hex)=":OCONV(arg,"MX"):" ":arg;PRINT 014 REPEAT 015 REPEAT;STATUS=1;RETURN;END DKNFN 001 SUBROUTINE (MAT N) 002 *Normalize File Names (in Kermit sense) 003 *7/8/87 JF3 0.3.0 004 * 005 DIM N(3) 006 EQU name TO N(1),type TO N(2),sep TO N(3) 007 FOR p=1 TO 2 008 string="";c=1;LOOP C=N(p)[c,1] UNTIL C="" DO 009 s=SEQ(C);BEGIN CASE 010 CASE s<=47;C="X" 011 CASE 58<=s AND s<=64;C="X" 012 CASE 91<=s AND s<=96;C="X" 013 CASE 97<=s AND s<=122;C=CHAR(s-32) 014 CASE (123<=s);C="X" 015 END CASE;string=string:C;c=c+1 016 REPEAT;N(p)=string 017 NEXT p;IF type="" THEN sep="" ELSE sep="." 018 RETURN 019 * * * * * Interface info * * * * * 020 *Entry: name := file name in Kermit sense 021 * type := " type " " " 022 * sep := seperator character 023 * 024 *Exit: as above but normalized per Kermit Protocol Manual 025 * * * * * Revision history * * * * * 026 *.0 - 7/8/87 JF3 027 END DKA09 001 SUBROUTINE (status) 002 *check received Attribute 9 (access) 003 *6/29/87 JF3 0.3.0 004 * 005 COM X1(41),item 006 EQU Access TO status 007 BEGIN CASE 008 CASE Access="N" 009 CASE Access="S" 010 CASE Access="A" 011 CASE 1;status=0 012 END CASE 013 RETURN 014 * * * * * Interface info * * * * * 015 *Entry: status := file access character 016 * 017 *Exit: status := 1 if ok; 0 otherwise 018 * * * * * Revision history * * * * * 019 *.0 - 6/29/87 JF3 020 END DKCNV 001 SUBROUTINE (arg,cnv,index) 002 *Convert parameters to COM format 003 *5/8/87 JF3 0.3.0 004 !]DKcnv]DKCTL 005 COM P(64);I=index<1>;RETREIVE=(I<0);I=ABS(I) 006 IF RETREIVE THEN 007 GOSUB 10;IF a THEN arg=P(I)<a,v> ELSE arg=P(I) 008 END;IF NUM(cnv) THEN c=ABS(cnv) ELSE 009 IF cnv="" THEN c=0 ELSE 010 SUBR="DK":cnv<1,1>;c=cnv<1,2>;CALL @SUBR(arg,c,index) 011 END 012 END;BEGIN CASE 013 CASE c=1;IF cnv>0 THEN arg=CHAR(arg+32) ELSE arg=SEQ(arg)-32 014 CASE c=2;IF cnv>0 THEN 015 IF arg="ON" THEN arg=1 ELSE arg=0 016 END ELSE 017 IF arg=1 THEN arg="ON" ELSE arg="OFF" 018 END 019 CASE c=3;IF cnv>0 THEN arg=CHAR(arg) ELSE arg=SEQ(arg) 020 CASE c=4;*[0<=arg<=31 or arg=127] or OCONV[] 021 * DK1.2="U2":P(47)<1,1>;*Microdata/Ultimate 022 * arg=OCONV(arg,DK1.2); *Microdata/Ultimate 023 CALL DKCTL(arg); *PICK 024 CASE 1;cnv=c 025 END CASE;IF index<1>>0 THEN 026 GOSUB 10;IF arg="x" THEN arg="" 027 IF a THEN 028 P(I)<a,v>=arg;IF s#"" THEN P(I)<2,v>=s 029 END ELSE P(I)=arg 030 END;RETURN 031 10 s=index<2>;IF s="" THEN a=0;v=0 ELSE 032 IF s<99 THEN 033 a=1 034 * LOCATE s IN P(I)<2> SETTING v ELSE NULL;*Microdata/Ultimate 035 LOCATE(s,P(I),2;v) ELSE NULL; *PICK 036 END ELSE a=s-100;v=1;s="" 037 END;RETURN 038 * * * * * Interface info * * * * * 039 * Entry: 040 * arg := contains data to be operated upon or 041 * is destination of data retrieved. 042 * cnv := DK conversion code: 043 * null or 0 means no conversion 044 * numeric means convert here: 045 * >0 : convert to internal/packet 046 * <0 : convert to external 047 * non-numeric means call external subroutine 048 * index <1>:= COM position: Neg. means retreive data; pos. means 049 * store data, 0 means ignore COM data. 050 * <2>:= <=99 means code associated with subparameter 051 * else 100+attr# within COM variable of data 052 * Null means single valued data. 053 * Exit: 054 * arg := data as converted 055 * cnv := }modified only on 056 * index := } error detection. 057 * * * * * Revision history * * * * * 058 *.0 - 5/8/87 JF3 059 END DKXPKTS 001 SUBROUTINE (STATUS) 002 *eXchange PacKeTS (send or receive) 003 *10/22/88 JF3 0.3.1 004 *]DKIO]DKVPKT]DKRETRY]DKACK]DKERR]DKFPKT 005 COM X1(4),n,DATA,CHECK,TYPE,LIMIT,X2(11),EOL,X3(2),CHKT,X4(12),r 006 EQU LEN TO STATUS,ok TO STATUS,AM TO CHAR(254) 007 xmt.pkt=DATA:CHECK;function=STATUS;ok=0;r=0;LOOP 008 DATA=xmt.pkt;PROMPT EOL;IF function>=0 THEN 009 STATUS=2;CALL DKIO(STATUS);STATUS=function;CALL DKVPKT(STATUS) 010 IF STATUS>0 THEN 011 IF TYPE="E" THEN 012 * If local mode then print msg on screen 013 DATA="";CALL DKACK("Y");CALL DKIO(-2);STATUS=0;ok=0 014 END ELSE ok=STATUS;DATA=DATA[5,LEN-2-CHKT] 015 END 016 END ELSE CALL DKIO(-2);STATUS=1;ok=STATUS 017 UNTIL STATUS=ok DO 018 CALL DKRETRY(STATUS);IF NOT(ok) THEN GO 9 019 REPEAT;9 RETURN 020 * * * * * Interface info * * * * * 021 *Entry: DATA := DATA field of packet to send 022 * CHECK := check code the packet 023 * STATUS := function indicator: 024 * >=0 means input a response packet after sending a packet 025 * -1 " do not wait for answer; just terminate packet 026 * 027 *Exit: DATA := disassembled received packet data 028 * STATUS := 0 means retry limit exceeded 029 * 1 " received packet ok 030 * -1 " E packet received 031 * * * * * Revision history * * * * * 032 *.1 - 10/22/88 JF3 033 * 034 *.0 - 10/21/88 JF3 035 END DKVPKT 001 SUBROUTINE (STATUS) 002 *Verify a received packet 003 *3/27/89 JF3 0.3.1 004 *]DKCHECK]CKCNV 005 COM X1(3),MARK,CTRL.SEQ,PACKET,CHECK,TYPE,X2,DEBUG.MODE,X3(13),CHKT 006 EQU LEN TO STATUS;RECEIVER=STATUS;TYPE="" 007 STATUS=INDEX(PACKET,MARK,1);IF STATUS THEN 008 IF STATUS>1 THEN PACKET=PACKET[STATUS,99999] 009 CHECK=1;CALL DKCHECK(CHECK);IF CHECK="" THEN STATUS=-6 ELSE 010 LEN=PACKET[2,1];CALL DKCNV(LEN,-1,0) 011 IF CHECK=PACKET[LEN+3-CHKT,CHKT] THEN 012 TYPE=PACKET[4,1];BEGIN CASE 013 CASE TYPE="D";CASE TYPE="Y";CASE TYPE="N";CASE TYPE="S" 014 CASE TYPE="B";CASE TYPE="F";CASE TYPE="Z";CASE TYPE="E" 015 CASE TYPE="A" 016 CASE 1;STATUS=-4;GO 9;END CASE 017 PACKET.SEQ=PACKET[3,1];CALL DKCNV(PACKET.SEQ,-1,0) 018 IF PACKET.SEQ#MOD(CTRL.SEQ+RECEIVER,64) THEN STATUS=-3 019 END ELSE STATUS=-2 020 END 021 END ELSE STATUS=-1 022 9 IF DEBUG.MODE THEN 023 PRINTER ON;PRINT ON 1;PRINT ON 1 "DKVPKT: ":STATUS 024 PRINT ON 1 OCONV(PACKET,"MX");PRINT ON 1;PRINTER OFF 025 END;RETURN 026 * * * * * Interface info * * * * * 027 *Entry: STATUS := false means send mode; true means receive mode 028 * PACKET := packet data as received from the line and 029 * as described in the Protocol Manual chapter 6. 030 * 031 *Exit: STATUS := LEN field (dec.) of packet if packet all ok; 032 * neg. error code if not. 033 END 034 * * * * * Revision history * * * * * 035 *.1 - 3/27/89 JF3 - Scan for MARK 036 * 037 *.0 - 10/21/88 JF3 DKXMTA 001 SUBROUTINE (STATUS) 002 *XMiT file Attribute packet(s) 003 *7/29/87 JF3 0.3.0 004 *]DKFPKT]DKXPKTS]DKFATAL 005 COM X1(5),PACKET,X2,RCV.PKT.TYPE,X3(8),MAXL,X4(6),CHKT,X5(23),F.A 006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS 007 max.len=MAXL-2-CHKT;pkt.len=0;PACKET="";v=0;LOOP 008 IF v THEN attribute=F.A<2,v> ELSE attribute=14 009 UNTIL attribute="" DO 010 IF v THEN DATA=F.A<1,v> ELSE DATA=PAR.LIST<10> 011 length=LEN(DATA) 012 pkt.len=pkt.len+length+2;IF pkt.len>max.len THEN GOSUB 5;PACKET="" 013 CALL DKCNV(attribute,1,0);CALL DKCNV(length,1,0) 014 PACKET=PACKET:attribute:length:DATA 015 v=v+1;REPEAT 016 5 XMT.PKT.TYPE="A";CALL DKFPKT(XMT.PKT.TYPE);IF OK THEN 017 RECEIVER=0;CALL DKXPKTS(RECEIVER) 018 IF RCV.PKT.TYPE="E" THEN CALL DKFATAL(STATUS) 019 END 020 RETURN 021 * * * * * Interface info * * * * * 022 *Entry: F.A := dynamic array of settable File Attribute data 023 * <1> := multivalued list of attribute data 024 * <2> := assoc. m.v. list of attr. codes 025 * * * * * Revision history * * * * * 026 *.0 - 7/29/87 JF3 027 END DKACK 001 SUBROUTINE (STATUS) 002 *set up an ACKnowledge packet 003 *10/21/88 JF3 0.3.0 004 *]DKFPKT 005 COM X1(4),n,DATA,X2(30),r 006 BEGIN CASE 007 CASE STATUS="Y" 008 CASE STATUS="E" 009 CASE STATUS="N";DATA="";GO 9 010 CASE 1;STATUS="Y":STATUS 011 END CASE;n=MOD(n+1,64);r=0;9 CALL DKFPKT(STATUS);RETURN 012 * * * * * Interface info * * * * * 013 *Entry: STATUS := "E" if error msg for acknowledgement 014 * "Y" for plain ack. 015 * otherwise carry packet type thru to FormPacKeT 016 * 017 *Exit: STATUS See DKFPKT. 018 * r := retry counter set to 0 019 * * * * * Revision history * * * * * 020 *.0 - 10/21/88 JF3 021 END DKXMTB 001 SUBROUTINE (STATUS) 002 *Transmit a Break Transmission pkt. 003 *1/29/87 JF3 0.3.0 004 *]DKFPKT]DKXPKTS]DKFATAL 005 COM X1(5),DATA,X2,RCV.PKT.TYPE 006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS 007 XMT.PKT.TYPE="B";DATA="";CALL DKFPKT(XMT.PKT.TYPE);IF OK THEN 008 STATUS=0;CALL DKXPKTS(STATUS) 009 IF OK<=0 OR RCV.PKT.TYPE="E" THEN CALL DKFATAL(STATUS) ELSE 010 PROMPT">" 011 * ECHO.ON=OCONV(0,"U70E0");*Microdata 012 ECHO ON; *PICK/Ultimate 013 END 014 END;RETURN 015 * * * * * Interface info * * * * * 016 *Entry: none 017 *Exit: none - return to command level 018 * * * * * Revision history * * * * * 019 *.0 - 1/29/87 JF3 020 END DKSTATUS 001 SUBROUTINE (STATUS) 002 *Display Kermit status 003 *1/29/87 JF3 0.3.0 004 *]DKCNV 005 COM P(64);EQU PAR.LIST TO P(12) 006 p=1;LOOP PARAM=PAR.LIST<2,p> UNTIL PARAM="" DO 007 index=-PAR.LIST<3,p>;cnv=PAR.LIST<5,p>;IF NUM(cnv) THEN cnv=-cnv 008 CALL DKCNV(arg,cnv,index);PRINT PARAM:"=":arg 009 p=p+1;REPEAT;STATUS=1;RETURN 010 * * * * * Interface info * * * * * 011 * Entry: 012 * PAR.LIST := <2,p> parameter p name 013 * := <3,p> COM position 014 * := <5,p> conversion type/subr name 015 * Exit: 016 * STATUS := 1 means finished ok 017 * * * * * Revision history * * * * * 018 *.0 - 1/29/87 JF3 Not yet ready for subparams. 019 END RDF 001 *MAIN 002 *Read distr. files in PROC PIB 003 *8/10/89 JF3 R83 2.2 004 PROCREAD PIB ELSE PRINT "Must be run from MAKE-DISTR PROC!";STOP 005 a=FIELD(PIB," ",1);list=FIELD(PIB," ",2) 006 OPEN "DICT","M/DICT" ELSE PRINT "NO M/DICT!";STOP 007 a=a+1;READV line FROM list,a ELSE PRINT "No DISTR-FILES";STOP 008 PIB=a:" ":line;PROCWRITE PIB 009 * * * * * Interface info * * * * * 010 *Entry: none - used only for the MAKE-DISTR and MAKE-COLUMBIA Procs 011 * * * * * Revision history * * * * * 012 *.1 - 8/10/89 JF3 Add Columbia files list 013 * 014 *.0 - 1/19/89 JF3 015 END DKRF1 001 SUBROUTINE (status) 002 *Receive a File name packet -- filetype = 1 -- UNUSED IN 0.3 003 *6/29/87 JF3 0.3 004 *]DKCNV 005 EQU AM TO CHAR(254) 006 IF item#"" THEN 007 CALL DKCNV(access,"",-16:AM:9);IF access="S" THEN item="" ELSE 008 status=0;GO 9 009 END;IF item<1>#"CC" AND item<1>#"CL" THEN 010 DK1.3="U3":FID<1,1>;beg.fid=OCONV("",DK1.3) 011 IF beg.fid THEN 012 item<12>=beg.fid;item<13>=1 013 END 014 END 015 END;9 RETURN 016 * * * * * Interface info * * * * * 017 *Entry: item := existing item body if any 018 * 019 *Exit: 020 END ANSITAPE 001 *MAIN 002 *Read ANSI formatted tape; convert to file item(s). Not usable for 0.3! 003 *12/30/86 JF3 4.2E 004 OPEN "DICT","DK" ELSE PRINT "No DICT DK!";STOP 005 READ ST FROM "ANSITAPE" ELSE 006 PRINT "No ANSITAPPE in DICT DK!";STOP 007 END;PRINT "DESTINATION FILE NAME:":;INPUT file.name 008 OPEN "",file.name ELSE PRINT "No such file!";STOP 009 EQU Symbol TO RCW;STATE=1;D=0;LOOP 010 p=1;READT block ELSE p=0 011 IF p THEN Symbol=block[p,4] 012 I=ST<3-p,STATE>;BEGIN CASE 013 CASE I=2;IF Symbol#"VOL1" THEN GO 9 014 CASE I=3 015 IF Symbol="HDR1" THEN 016 file.name=block[5,17];ext=TRIM(FIELD(file.name,".",2)) 017 IF ext[1,2]="DK" THEN 018 file.name=FIELD(file.name,".",1);a=1;item="" 019 END 020 END ELSE I=0 021 CASE I=4 022 IF Symbol="VOL1" THEN D=-1 ELSE 023 LOOP UNTIL RCW="" OR RCW[1,1]="^" DO 024 item<a>=block[p+4,RCW-4];a=a+1;p=p+RCW;RCW=block[p,4] 025 REPEAT;p=1;I=0 026 END 027 CASE I=5 028 IF Symbol="EOF1" THEN 029 WRITE item ON file.name 030 END ELSE I=0 031 CASE I=8;D=5 032 CASE I=9 033 9 PRINT "FORMAT ERROR!";PRINT "STATE=":STATE;STATE=99 034 IF p THEN PRINT block 035 END CASE;IF I THEN STATE=ST<4,STATE>+D;D=0 036 UNTIL STATE>=9 DO REPEAT 037 REWIND ELSE PRINT "TAPE NOT READY!" 038 END DKQUOT 001 SUBROUTINE (RX,f,F) 002 *Reconcile send-init Quote fields 003 *1/29/87 JF3 0.3.0 004 * 005 COM X1(21),QCTL,QBIN,CHKT,REPT,X2(28),SQCTL,SQBIN,SCHKT 006 BEGIN CASE 007 CASE f=7 008 BEGIN CASE 009 CASE F="N" OR F="" OR F=QCTL;GO 4 010 CASE F="Y";QBIN=SQBIN;F=QBIN 011 CASE 1;GOSUB 10;IF X THEN F="Y" ELSE 012 4 QBIN="";F="N" 013 END;END CASE 014 CASE f=8;IF F#SCHKT THEN CHKT=1 015 CASE f=9 016 BEGIN CASE 017 CASE F=" " OR F="" OR F=QCTL OR F=QBIN;GO 6 018 CASE 1;GOSUB 10;IF X THEN REPT=F ELSE 019 6 REPT="";F=" " 020 END;END CASE 021 END CASE;RETURN 022 10 X=SEQ(F);X=(33<=X AND X<=62) OR (96<=X AND X<=126);RETURN 023 * * * * * Interface info * * * * * 024 *Entry: RX := 1 if receiver, 0 if sender (Mistakenly not referenced!) 025 * f := Init packet field # 026 * F := " " " contents 027 *Exit: COM fields setup for transaction 028 * * * * * Revision history * * * * * 029 *.0 - 1/29/87 JF3 DKRETR 001 SUBROUTINE (STATUS) 002 *RETreive Record to send from system 003 *7/21/87 JF3 0.3.0 004 *]DKFTYPE 005 COM CMD.LINE,X1,ERR,X2,PKT.SEQ,DATA,CHECK,TYPE,X3,DEBUG.MODE 006 COM X4(6),MAXL,X5(6),CHKT,X6(9),PICK.file.type,p,L,X7(4) 007 COM ID,ITEM,rec.terminator,F.NAME,FV,filename.type,FID,X8(16),Type 008 EQU INITIAL.ENTRY TO STATUS,OK TO STATUS,AM TO CHAR(254),DK1 TO p 009 IF INITIAL.ENTRY THEN 010 PICK.file.type=filename.type<2>;DK1=FID<1,1> 011 BEGIN CASE 012 CASE PICK.file.type<2 013 READ ITEM FROM FV,ID ELSE DATA="item: ":ID;ID=4;GO 10 014 IF PICK.file.type=1 THEN 015 A1=ITEM<1> 016 * * * * * Ultimate * * * * * 017 IF A1="CC" OR A1="CL" THEN 018 STATUS=OCONV(ITEM<2>:",":ITEM<3>,"U3":DK1);IF OK THEN NULL 019 END ELSE PICK.file.type=0 020 END 021 CASE PICK.file.type=3 022 STATUS=OCONV(ID,"U0":DK1);IF OK THEN DK1="U1":DK1 ELSE 023 DATA="entry: ":ID;ID=4;GO 10 024 END 025 CASE 1 026 2 DATA="DATAFILE";ID=1;GO 10 027 END CASE;CALL DKFTYPE;L=INT(8*(MAXL-2-CHKT)/10) 028 IF NOT(PICK.file.type) THEN p=1 029 END ELSE 030 BEGIN CASE 031 CASE PICK.file.type<2 032 IF Type="A" THEN 033 DATA=FIELD(ITEM,AM,p);p=p+1;STATUS=NOT(COL2()) 034 DATA=DATA:rec.terminator 035 END ELSE DATA=ITEM[p,L];p=p+L;STATUS=(DATA="") 036 CASE PICK.file.type=3 037 STATUS=0;DATA=OCONV(L,DK1) 038 IF DATA=CHAR(0) OR DATA="" THEN STATUS=1 039 END CASE 040 END;9 RETURN 041 10 DATA=INSERT(DATA,1,0,0,"K":ID);STATUS=-1;GO 9 042 * * * * * Interface info * * * * * 043 *Entry: STATUS := 1 means first entry to retrieve data 044 * 0 means subsequent entry; return next record 045 * 046 *Exit: On INITIAL.ENTRY On subsequent entries 047 * ---------------- --------------------- 048 * STATUS := 1 means data ok 1 means last record 049 * 0 means more to go 050 * -----------------On either------------------- 051 * <0 means K-msg err id VM filler in DATA 052 *Uses: NFN := 1 means Normalized File Names in the 053 * Kermit sense 054 * * * * * Revision history * * * * * 055 *.0 - 7/21/87 JF3 056 END DKXMTZ 001 SUBROUTINE (STATUS) 002 *Transmit a End of File packet 003 *1/29/87 JF3 0.3.0 004 *]DKFPKT]DKXPKTS]DKFATAL 005 COM X1(5),DATA,X2,RCV.PKT.TYPE 006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS 007 XMT.PKT.TYPE="Z";DATA="";CALL DKFPKT(XMT.PKT.TYPE);IF OK THEN 008 STATUS=0;CALL DKXPKTS(STATUS) 009 IF OK<=0 OR RCV.PKT.TYPE="E" THEN CALL DKFATAL(STATUS) 010 END 011 9 RETURN 012 * * * * * Interface info * * * * * 013 *Entry: none 014 *Exit: transaction terminated 015 * * * * * Revision history * * * * * 016 *.0 - 1/29/87 JF3 017 END DKCOMMENT 001 SUBROUTINE (STATUS) 002 *no operation; just a COMMENT for TAKE files 003 *11/4/88 JF3 0.3.0 004 * 005 COM X1,HELP.LIST,X2(3),LINE 006 STATUS=1;RETURN 007 * * * * * Interface info * * * * * 008 *No interface needed 009 * * * * * Revision history * * * * * 010 * 011 *.0 11/4/88 JF3 012 END DKXMTD 001 SUBROUTINE (STATUS) 002 *Transmit Data packet(s) 003 *1/29/87 JF3 0.3.0 004 *]DKFPKT]DKXPKTS]DKFATAL 005 COM X1(5),DATA,X2,RCV.PKT.TYPE,X3(8),MAXL 006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS,LEN TO STATUS,RECEIVER TO STATUS 007 ALL.DATA=DATA;LEN.ALL.DATA=LEN(ALL.DATA);PTR=0;LOOP 008 XMT.PKT.TYPE="D";CALL DKFPKT(XMT.PKT.TYPE) 009 IF OK>0 THEN 010 PTR=PTR+LEN;RECEIVER=0;CALL DKXPKTS(RECEIVER) 011 IF RCV.PKT.TYPE="E" THEN CALL DKFATAL(STATUS) 012 END ELSE GO 9 013 UNTIL PTR=LEN.ALL.DATA DO DATA=ALL.DATA[PTR+1,MAXL] REPEAT 014 9 RETURN 015 * * * * * Interface info * * * * * 016 *Entry: DATA := data field of packet to send 017 * 018 *Exit: STATUS := # of chars sent if successful 019 * := <= 0 if unsuccessful 020 * * * * * Revision history * * * * * 021 *.0 - 1/29/87 JF3 022 END DKVERSION 001 SUBROUTINE (STATUS) 002 *Display current Kermit version & revision 003 *1/29/87 JF3 0.3.0 004 * 005 COM X1,HELP.LIST 006 PRINT HELP.LIST<1>[2,999];STATUS=1;RETURN 007 * * * * * Interface info * * * * * 008 *Entry: none 009 *Exit: none 010 * * * * * Revision history * * * * * 011 *.0 - 1/29/87 JF3 012 END DKCTL 001 SUBROUTINE (N) 002 *Perform Kermit ctl() function 003 *4/9/87 JF3 0.3.0 004 * 005 s=SEQ(N);BEGIN CASE 006 CASE s<=31 OR s=63;s=s+64 007 CASE 64<=s AND s<=95 OR s=127;s=s-64 008 CASE 1;N=" ";GO 9 009 END CASE;N=CHAR(s) 010 9 RETURN 011 * * * * * Interface Info * * * * * 012 * Entry: N contains a single character in the range: 013 * 0-31,63-95,127 (decimal) 014 * Exit: N contains Kermit ctl(N), i.e. N xor 64. 015 * * * * * Revision history * * * * * 016 *.0 - 4/9/87 JF3 017 END DKDF 001 SUBROUTINE (arg,c,index) 002 *Convert DATAFILE to include file type 003 *5/6/87 JF3 0.3.0 004 !]DKOPNFILE 005 COM X1(45),datafile 006 datafile=arg;BEGIN CASE 007 CASE c=1 008 BEGIN CASE 009 CASE arg="TERMINAL";type="2" 010 CASE arg="SPOOLER";type="3" 011 CASE 1 012 CALL DKOPNFILE(type);IF type<0 THEN 013 c="K4";c<2>="file: ":arg;index<1>=0;GO 9 014 END 015 END CASE;index<2>=type 016 CASE c=-1 017 arg=datafile<1>;type=datafile<2> 018 IF type#"" THEN arg=arg:" <":type:">" 019 CASE 1 020 * INS "K10" BEFORE c<1>;c<2,2>="DKDF"; *ULTIMATE/Microdata 021 c=INSERT(c,1,0,0,"K10");c<2,2>="DKDF";*PICK 022 9 arg="!!!";datafile="";GO 10 023 END CASE;c=0;10 RETURN 024 * * * * * Interface info * * * * * 025 * Entry: 026 * if c=1 then convert from display to internal formats with file opening 027 * arg := [ {DICT }filename ] 028 * [ SPOOLER ] 029 * if c=-1 then convert from internal to display formats 030 * arg<1> := as above plus 031 * arg<2> := [ null ] if ordinary data file or 032 * [ P ] if SPOOLER. 033 * Exit: 034 * arg := opposite form of c=1 to c=-1 above (conv ok) 035 * := "!!!" indicates fatal error 036 * c=0 := no further conversions (conv ok) 037 * c<1> := fatal error message item-id 038 * c<2> := multivalued parameters for error message 039 * * * * * Revision history * * * * * 040 *.0 - 5/6/87 JF3 041 END DKSERVER 001 SUBROUTINE (STATUS) 002 *go into SERVER mode for command input - NOT USED in 0.3 003 *6/25/87 JF3 004 *]DKRCVG]DKXPKTS]DKRCVt]DKACK 005 COM X1(5),msg,X2(33),remote.control 006 msg="K20";STATUS="!";CALL DKIO(STATUS) 007 remote.control=1 008 STATUS=1;RETURN 009 * * * * * Interface info * * * * * 010 *Entry: none 011 * 012 *Exit: remote.control := set to Server mode = "1" 013 * * * * * Revision history * * * * * 014 *.0 - 6/25/87 JF3 015 END DKATTRS 001 SUBROUTINE (STATUS) 002 *Send file ATTRibuteS -- UNUSED IN 0.3 003 *7/14/87 JF3 004 *]DKCNV]DKXMTA 005 COM X1(2),ERR,X2(2),DATA,X3(38),FV,FILE.NAME 006 CALL DKCNV(ATTRS.ON,0,0);*NEEDS TO BE FIXED 007 IF ATTRS.ON THEN 008 A=1;ATTRS=1;LOOP 009 index=-(32*A-6);CALL DKCNV(OK,"",index);ATTRS=ATTRS*OK 010 WHILE ATTRS AND A<2 DO A=A+1 REPEAT 011 IF ATTRS THEN CALL DKXMTA(STATUS) ELSE OK=1 012 END;RETURN 013 * * * * * Interface info * * * * * 014 *Entry: 015 * 016 *Exit: 017 * * * * * Revision history * * * * * 018 *.0 - 7/14/87 JF3 019 END DKTAKE 001 SUBROUTINE (STATUS) 002 *Take sequence of commands from file item (begin attr. 2) 003 *1/29/87 JF3 0.3.1 004 *]DKOPNFILE]DKPARSE]DKcmd]PERR 005 COM CMD.LINE,X1,ERR,X2(2),DATA,X3(38),FV,FILE.NAME 006 EQU LF TO CHAR(10),CR TO CHAR(13),SPACE TO " ",OK TO STATUS 007 EQU VM TO CHAR(253),AM TO CHAR(254),MSG TO STATUS,ID TO STATUS 008 CALL DKOPNFILE(STATUS);IF OK THEN 009 ID=FIELD(CMD.LINE,SPACE,I);IF ID="" THEN ITEM="" ELSE 010 READ ITEM FROM FV,ID ELSE MSG=ID:VM:FILE.NAME;ID=21;GO 7 011 END;A=2;LOOP CMD=ITEM<A> UNTIL CMD="" DO 012 C=CMD;CALL DKPARSE(C) 013 IF C THEN SUBR="DK":CMD;CALL @SUBR(STATUS) ELSE ID="K1";MSG="";GOSUB 7 014 A=A+1;REPEAT 015 END ELSE ID="K0";MSG="" 016 7 CALL PERR(0,0,ERR,ID,MSG);8 STATUS=0;9 RETURN 017 * * * * * Interface info * * * * * 018 * 019 * * * * * Revision history * * * * * 020 *.1 11/4/88 JF3 Change to multi-attribute command format 021 * 022 *.0 1/29/87 JF3 023 END DKDFAULT 001 SUBROUTINE (STATUS) 002 *set DEFAULT parameters 003 *6/25/87 JF3 0.3.0 004 *]PERR]DKCNV 005 COM P(64);EQU SVM TO CHAR(252),VM TO CHAR(253) 006 EQU HELP.LIST TO P(2),ERR TO P(3),MSG TO P(6),PAR.LIST TO P(12) 007 EQU DK.MD TO P(15),UM.FIDS TO P(47) 008 id="HELP";READ HELP.LIST FROM DK.MD,id ELSE GO 4 009 id="PARAMS";READ PAR.LIST FROM DK.MD,id ELSE 010 4 CALL PERR(0,0,ERR,21,id:VM:"DK-MD");STOP 011 END;UM.FIDS=PAR.LIST<13> 012 v=1;LOOP PAR=PAR.LIST<2,v> UNTIL PAR="" DO 013 index=PAR.LIST<3,v>;cnv=PAR.LIST<5,v>;s=1;arg.list=PAR.LIST<7,v> 014 IF NOT(NUM(cnv)) THEN cnv<1,2>=1 015 LOOP arg=FIELD(arg.list,SVM,s) WHILE COL2() DO 016 IF arg#"" THEN 017 index<2>=PAR.LIST<9,v,s>;CALL DKCNV(arg,cnv,index) 018 IF arg="!!!" THEN MSG=cnv;CALL DKIO("!");STATUS=0;GO 9 019 END 020 s=s+1;REPEAT;index=index<1>;IF 49<=index AND index<=61 THEN 021 P(index-32)=P(index) 022 END;v=v+1 023 REPEAT;STATUS=1;9 RETURN 024 * * * * * Interface info * * * * * 025 *Entry: none (execpt in COM) 026 *Exit: STATUS set true 027 * * * * * Revision history * * * * * 028 *.0 - 6/25/87 JF3 029 END DKXMTF 001 SUBROUTINE (STATUS) 002 *Transmit a File Header packet 003 *1/29/87 JF3 0.3.0 004 *]DKFPKT]DKXPKTS]DKFATAL 005 COM X1(7),RCV.PKT.TYPE 006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS 007 XMT.PKT.TYPE="F";CALL DKFPKT(XMT.PKT.TYPE);IF OK THEN 008 RECEIVER=0;CALL DKXPKTS(RECEIVER) 009 IF RCV.PKT.TYPE="E" THEN CALL DKFATAL(STATUS) 010 END;RETURN 011 * * * * * Interface info * * * * * 012 *Entry: none 013 *Exit: none 014 * neg. error code if not. 015 * * * * * Revision history * * * * * 016 *.0 - 1/29/87 JF3 017 END DKERR 001 SUBROUTINE DKERR 002 *Format ERRor messages for output 003 *5/6/87 JF3 0.3.0 004 *]PERR 005 COM X1(2),ERR,X2(2),msg;EQU VM TO CHAR(253) 006 i=msg<1>;READV MSG FROM ERR,i,2 ELSE MSG="No '":i:"' in DK-ERR!" 007 msg=msg<2>;i=1;j=1;OMSG="" 008 LOOP X=FIELD(MSG,VM,i) UNTIL COL2()=0 DO 009 IF X="" THEN X=msg<1,j>;j=j+1 010 OMSG=OMSG:X;i=i+1 011 REPEAT;msg=OMSG;RETURN 012 * * * * * Interface info * * * * * 013 * Entry: 014 * msg<1> := error msg item-id in ERR file 015 * <2> := filler for msg body (multivalued) 016 * 017 * Exit: 018 * msg := formatted msg for output 019 * * * * * Revision history * * * * * 020 *.0 - 5/6/87 JF3 021 END DKAnn 001 *DUMMY 002 *called subroutine list and common interface for received A packets 003 *7/21/87 JF3 0.3.0 004 *]DKA01]DKA02]DKA09]DKA15 005 * * * * * Interface info * * * * * 006 *Entry: STATUS := DATA portion of subfield of A packet 007 * 008 *Exit: 009 * * * * * Revision history * * * * * 010 *.0 - 7/21/87 JF3 011 END DKINIT 001 SUBROUTINE (STATUS) 002 *Initial Send-init parameters 003 *4/9/87 JF3 0.3.0 004 *]DKCNV]DKDBUG 005 COM X1(2),ERR,X2(2),DATA,X3(3),DEBUG.MODE,X4(38) 006 COM SPAR(16);EQU AM TO CHAR(254),VM TO CHAR(253) 007 C=1:AM:1:AM:1:AM:AM:-3:AM:AM:AM:AM:AM:"CAPAS":VM:1:AM:1:AM:1:AM:1 008 DATA="";FOR index=49 TO 61 009 I=index-48;CALL DKCNV(arg,C<I>,-index) 010 IF index=52 THEN CALL DKCNV(arg,4,0) 011 IF index=53 THEN CALL DKCNV(arg,1,0) 012 DATA=DATA:arg 013 NEXT index;IF DEBUG.MODE THEN 014 SAVE=DATA;I=LEN(DATA)+3;CALL DKCNV(I,1,0) 015 DATA=CHAR(0):I:" ":DATA:" ";CALL DKDBUG("I");DATA=SAVE 016 END;STATUS=1;RETURN 017 * * * * * Interface info * * * * * 018 *Entry: none 019 *Exit: send-init packet setup 020 * * * * * Revision history * * * * * 021 *.0 - 4/9/87 JF3 022 END DKA15 001 SUBROUTINE (STATUS) 002 *check received Attribute 15 (Format) -- UNUSED IN 0.3 003 *6/11/87 JF3 004 *]DKCTL]DKCNV 005 COM X1(42),record.termination,X2(19),p.format 006 EQU DATA TO STATUS,rec.size.len TO record.termination 007 p.format=DATA[1,1];record.termination="";ix=43;BEGIN CASE 008 CASE p.format="A" 009 i=2;LOOP c=DATA[i,1] UNTIL c="" DO 010 CALL DKCTL(c);record.termination=record.termination:c 011 i=i+1;REPEAT;GO 9 012 CASE p.format="D";l=1 013 CASE p.format="F";l=4 014 CASE p.format="M";l=1;ix=0;*NEEDS TO BE FIXED 015 CASE p.format="R";l=1;ix=0 016 CASE 1;STATUS=0;GO 9 017 END CASE;arg=DATA[2,l];IF l=1 THEN 018 IF NUM(arg) THEN cnv=0 ELSE cnv=-1 019 CALL DKCNV(arg,cnv,ix) 020 END;8 STATUS=1;9 RETURN 021 * * * * * Interface info * * * * * 022 * * * * * Revision history * * * * * 023 *.0 - 6/11/87 JF3 024 END DKFATAL 001 *TERM 002 *Process fatal errors; print diagnostic msg 003 *1/29/87 JF3 0.3 004 * 005 COM X(62),line,prog 006 *Should call DKIO here ! 007 PRINT "?Fatal error in LINE ":line:" of ":prog 008 * * * * * Interface info * * * * * 009 *Entry: line := source line # of problem program 010 * prog := problem program name 011 *Exit: none 012 * * * * * Revision history * * * * * 013 *.0 - 1/29/87 JF3 014 END DKXMTG 001 SUBROUTINE (STATUS) 002 *XMiT a Generic server command -- UNUSED IN 0.3 003 *8/7/87 JF3 004 *]DKFPKT]DKXPKTS]DKFATAL 005 COM X1(4),n,DATA,X2,RCV.PKT.TYPE,X3(8),MAXL 006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS,LEN TO STATUS,RECEIVER TO STATUS 007 XMT.PKT.TYPE="G";n=0;CALL DKFPKT(XMT.PKT.TYPE);IF OK THEN 008 RECEIVER=0;CALL DKXPKTS(RECEIVER) 009 BEGIN CASE 010 CASE RCV.PKT.TYPE="S" 011 IF DATAFILE#"" THEN 012 CALL DKRECON(STATUS) 013 CALL DKRECEIVE(STATUS) 014 END 015 CASE RCV.PKT.TYPE="X" 016 * Set up to type on terminal 017 n=n+1 018 CASE RCV.PKT.TYPE="Y" 019 GOSUB 10 020 CASE RCV.PKT.TYPE="N" 021 CASE 1 022 END CASE 023 END 024 RETURN 025 10 CALL DKIO(STATUS);RETURN 026 * * * * * Interface info * * * * * 027 *Entry: DATA := single character command. See KPM 8.2.1. Must be 028 * less than MAXL long. 029 * 030 *Exit: STATUS := 0 means DATA too long 031 * 1 " all went ok 032 * * * * * Revision history * * * * * 033 *.0 - 8/7/87 JF3 034 END KERMIT 001 *MAIN 002 *DATA/KERMIT 003 *6/30/87 JF3 0.3.0 004 *]OPENFILE]DKDFAULT]GTRMCHR]DKEXEC]DKIO 005 COM P(64);DIM i(3),Q(29) 006 EQU ERR TO P(3),MSG TO P(6),PARAMS TO P(12) 007 EQU DK.MD TO P(15),CMD.PROMPT TO P(33),REMOTE.CTRL TO P(40),c TO i(1) 008 EQU LF TO CHAR(10),CR TO CHAR(13) 009 MAT P="";MAT i="";MAT Q="" 010 CALL OPENFILE("DICT","DK-MD",DK.MD);CALL OPENFILE("","DK-ERR",ERR) 011 CALL DKDFAULT(status);IF REMOTE.CTRL="" THEN 012 CALL GTRMCHR(MSG);CLR.SCRN=MSG<1,1> 013 MSG=CLR.SCRN:PARAMS<1>[2,99];status=0;GOSUB 10 014 MSG=CR:LF;status=0;GOSUB 10 015 END;LOOP 016 CALL DKEXEC(status) 017 WHILE status DO REPEAT;STOP 018 10 CALL DKIO(status);RETURN 019 * * * * * Interface info * * * * * 020 *Entry: none 021 * 022 * * * * * Revision history * * * * * 023 *.0 - 6/30/87 JF3 024 END DKDBUG 001 SUBROUTINE (STATUS) 002 *Print KERMIT debug data on printer or pause for input/examine 003 *7/29/87 JF3 0.3.0 004 *]DKCNV 005 COM command,X1(4),DATA,X2(17),CHKT;EQU MX TO "MX",FMT TO "L#6" 006 IF command<1>="!DBUG" THEN 007 DATA="D/K DEBUG";STATUS=1;CALL DKIO(STATUS);STATUS=1 008 END ELSE 009 PRINTER ON;IF STATUS="H" THEN 010 PRINT ON 1 " DATA/KERMIT DEBUG OUTPUT" 011 PRINT ON 1 "" 012 PRINT ON 1 "STAT MARK LEN SEQ TYPE CHECK " 013 PRINT ON 1 " hex dec dec chr dec TIME " 014 PRINT ON 1 "";PRINT ON 1 " {DATA...}" 015 END ELSE 016 PRINT ON 1 "";PRINT ON 1 STATUS FMT:;FOR F=1 TO 5 017 IF F<5 THEN D=DATA[F,1] ELSE D=DATA[L+3-CHKT,CHKT] 018 IF F=1 THEN D=OCONV(D,MX) 019 IF F=2 OR F=3 THEN CALL DKCNV(D,-1,0) 020 IF F=2 THEN L=D 021 IF F=5 THEN 022 BEGIN CASE 023 CASE CHKT=1;CALL DKCNV(D,-1,0) 024 * CASE CHKT=2 025 * CASE CHKT=3 026 END CASE 027 END;PRINT ON 1 D FMT: 028 NEXT F;PRINT ON 1 OCONV(TIME(),"MTHS") 029 PRINT ON 1 ""FMT:"{":DATA[5,L-2-CHKT]:"}" 030 END;PRINTER OFF 031 END;RETURN 032 * * * * * Interface info * * * * * 033 *Entry: command := "!DBUG" means pause for input to eximane 034 * variables 035 * else print formatted packet data on logical 036 * printfile #1 037 * * * * * Revision history * * * * * 038 *.0 - 7/29/87 JF3 039 END DKEXEC 001 SUBROUTINE (status) 002 *EXEcute a Command 003 *10/17/88 JF3 0.3.1 004 *]DKIO]DKVERC 005 COM command.line,X1(4),DATA,X2(4),DELAY,X3(3),DK.MD,X4(17),CMD.PROMPT 006 COM X5(6),REMOTE.MODE;EQU LF TO CHAR(10),CR TO CHAR(13) 007 a=1;BEGIN CASE 008 CASE REMOTE.MODE=0 009 CASE REMOTE.MODE="" OR ABS(REMOTE.MODE)=1 010 DATA=CR:LF:CMD.PROMPT<3>;status=1;GOSUB 12 011 CASE REMOTE.MODE=2 012 DATA="";CALL DKXPKTS(status) 013 CASE REMOTE.MODE=3 014 id="COMMANDS";READU command.line FROM DK.MD,id ELSE RELEASE DK.MD,id 015 IF command.line="" THEN FOR s=1 TO DELAY;RQM 1;NEXT s ELSE 016 a=command.line<1>[2,9];WRITEV "K":a ON DK.MD,id,1 017 END 018 END CASE;IF REMOTE.MODE<2 THEN command.line=DATA;GOSUB 10 019 status=FIELD(command.line<a>," ",1);IF status="" THEN status=1 ELSE 020 CALL DKVERC(status);IF status>0 THEN 021 subroutine=DATA 022 IF REMOTE.MODE<2 THEN GOSUB 10 023 CALL @subroutine(status) 024 END 025 END;RETURN 026 10 DATA="";status=-1;12 CALL DKIO(status);RETURN 027 * * * * * Interface info * * * * * 028 *Entry: REMOTE.MODE := -1 means phantom for local mode 029 * 0 " local modes 030 * 1 " remote mode operation 031 * 2 " server mode 032 * 3 " remote command mode 033 * 034 *Exit: 035 * * * * * Revision history * * * * * 036 * 037 *.1 10/17/88 JF3 Fix batch capability 038 * 039 *.0 1/29/87 JF3 040 END DKFTYPE 001 SUBROUTINE DKFTYPE 002 *Set up record delimiter form File attribute TYPE 003 *7/14/87 JF3 0.3.0 004 *]DKCNV 005 COM X1(42),rec.delim,X2(20),Type;EQU AM TO CHAR(254) 006 CALL DKCNV(Type,0,-48:AM:2);Opt=Type[2,9];Type=Type[1,1] 007 BEGIN CASE 008 CASE Type="A" 009 IF Opt="" THEN Opt="MJ" 010 c=1;rec.delim="";LOOP O=Opt[c,1] UNTIL O="" DO 011 CALL DKCNV(O,4,0);rec.delim=rec.delim:O 012 c=c+1;REPEAT 013 CASE Type="B" 014 IF Opt="" THEN Opt=8 015 rec.delim="" 016 CASE Type="I" 017 IF Opt="" THEN Opt=8 018 rec.delim="" 019 END CASE;RETURN 020 * * * * * Interface info * * * * * 021 *Entry: F.A := see DKXMTA 022 * 023 * * * * * Revision history * * * * * 024 *.0 - 7/14/87 JF3 025 END DKRCVS 001 SUBROUTINE (STATUS) 002 *ReCeiVe a Send-init packet to initialize 003 *10/21/88 JF3 0.3.0 004 *]DKDBUG]DKXPKTS]DKVPKT]DKRECON]DKACK 005 COM X1(3),MARK,PKT.SEQ,DATA,CHECK,TYP,LIMIT,DEBUG.MODE,X2(10),EOL 006 COM X3(11),CMD.PROMPT,X4(3),RETRY,LINE,X5,REMOTE.CTRL 007 *ECHO.OFF=OCONV(0,"U80E0");*Microdata 008 ECHO OFF; *PICK/Ultimate 009 IF DEBUG.MODE THEN CALL DKDBUG("H") 010 PKT.SEQ=-1;first.pkt=1;ok=0;PROMPT"";LOOP 011 IF first.pkt THEN 012 3 STATUS=3;CALL DKIO(STATUS);first.pkt=0;PROMPT EOL 013 c=1;LOOP C=DATA[c,1] UNTIL C=MARK OR C="" DO c=c+1 REPEAT 014 IF C="" THEN DATA="";GO 3 ELSE DATA=DATA[c,9999] 015 END ELSE STATUS=1;CALL DKXPKTS(STATUS) 016 * Timeout check goes here 017 5 STATUS=1;CALL DKVPKT(STATUS);IF STATUS>0 THEN 018 IF TYP="S" THEN 019 ok=1;DATA=DATA[5,LEN(DATA)-5];CALL DKRECON(STATUS) 020 END ELSE STATUS=-4;ok=STATUS 021 END 022 UNTIL STATUS=ok DO 023 RETRY=RETRY+1;IF RETRY>=LIMIT THEN 024 * ECHO.ON=OCONV(0,"U70E0");*Microdata 025 ECHO ON; *PICK/Ultimate 026 GO 9 027 END ELSE CALL DKACK("N") 028 REPEAT;9 RETURN 029 * * * * * Interface info * * * * * 030 *Entry: none 031 * 032 *Exit: 033 * STATUS := 1 means all ok 034 * -4 " non-S packet received 035 * * * * * Revision history * * * * * 036 *.0 - 10/21/88 JF3 037 END DKRECEIVE 001 SUBROUTINE (STATUS) 002 *RECEIVE data transaction 003 *7/17/89 JF3 0.3.1 004 *]DKRCVS]DKACK]DKXPKTS]DKRCVF]DKRCVA]DKRCVD]DKRCVZ 005 COM CMD.LINE,X1,ERR,X2,n,DATA,CHECK,TYPE,X3,DEBUG.MODE 006 COM X4(23),PICK.file.type,X5(2),r,X6(6),local.dest.filespec,FV,FN 007 EQU OK TO STATUS,LF TO CHAR(10),CR TO CHAR(13) 008 OK=1;local.dest.filespec=FIELD(CMD.LINE<1>," ",2);PICK.file.type=FN<2> 009 local.dest.filespec="" 010 *IF local.dest.filespec#"" AND PICK.file.type>1 THEN STATUS=-1;GO 9 011 r=0;CALL DKRCVS(STATUS);IF OK>0 THEN 012 STATUS="S";CALL DKACK(STATUS);LOOP 013 STATUS=1;CALL DKXPKTS(STATUS) 014 UNTIL STATUS<=0 DO 015 BEGIN CASE 016 CASE TYPE="F";CALL DKRCVF(STATUS) 017 CASE TYPE="A";CALL DKRCVA(STATUS) 018 CASE TYPE="D";CALL DKRCVD(STATUS) 019 CASE TYPE="Z";CALL DKRCVZ(STATUS) 020 CASE TYPE="B";CALL DKRCVB(STATUS);GO 8 021 END CASE;IF NOT(OK) THEN GO 9 022 IF TYPE="A" THEN STATUS="A" ELSE STATUS="Y" 023 CALL DKACK(STATUS);IF NOT(OK) THEN GO 9 024 REPEAT;IF OK THEN 025 8 STATUS="Y";DATA="";CALL DKACK(STATUS);IF OK THEN CALL DKXPKTS(-1) 026 END 027 END;9 RETURN 028 * * * * * Interface info * * * * * 029 *Entry: CMD.LINE := receive command in form: 030 * RECEIVE [item-id] 031 * where optional "item-id" is id under which to 032 * store data in set DATAFILE. 033 * FN := destination file name (<1>) and DATA/KERMIT 034 * file type (<2>) as defined in DKOPNFILE. 035 * 036 *Uses: r := retry count per Kermit Protocol Manual 037 * n := packet sequence 038 * 039 *Exit: STATUS := result of operation: 040 * 0 means error occured 041 * 1 " all went ok 042 * 043 * * * * * Revision history * * * * * 044 *.1 - 7/17/89 JF3 Call to DKRCVB to get ECHO back ON. 045 * 046 *.0 - 10/22/88 JF3 047 END DKFRMAT 001 SUBROUTINE DKFRMAT 002 *FoRMAT packet data -- UNUSED IN 0.3 003 *1/23/89 JF3 004 !]DKFNAME]DKFTYPE]DKXMTD 005 COM CMD.LINE,X1,ERR,X2,PKT.SEQ,DATA,CHECK,TYPE,X3,DEBUG.MODE 006 COM X4(6),MAXL,X5(6),CHKT,X6(9),f.type,p,L,X7(4) 007 COM ID,ITEM,rec.delim,F.NAME,FV,filename.type,FID,X8(15),Format,Type 008 EQU INITIAL.ENTRY TO STATUS,OK TO STATUS,AM TO CHAR(254),DK1 TO p 009 IF INITIAL.ENTRY THEN 010 f.type=filename.type<2>;p=1 011 BEGIN CASE 012 CASE f.type<2 013 READ ITEM FROM FV,ID ELSE 014 DATA="item: ":ID;ID=4;GO 10 015 END 016 CASE f.type=3 017 DK1=FID<1,1> 018 STATUS=OCONV(ID,"U0":DK1);IF OK THEN DK1="U1":DK1 ELSE 019 DATA="entry: ":ID;ID=4;GO 10 020 END 021 CASE 1 022 2 DATA="DATAFILE";ID=1;GO 10 023 END CASE;IF F.NAME="" THEN CALL DKFNAME 024 CALL DKFTYPE;L=INT(8*(MAXL-2-CHKT)/10) 025 END ELSE 026 BEGIN CASE 027 CASE f.type<2 028 LOOP 029 IF Type="A" THEN DATA=FIELD(ITEM,AM,p);p=p+1 ELSE 030 DATA=ITEM[p,L];p=p+L 031 END 032 UNTIL DATA="" DO p=p+1 REPEAT 033 CASE f.type=3 034 STATUS=0;DATA=OCONV(L,DK1) 035 IF DATA=CHAR(0) OR DATA="" THEN STATUS=1 036 END CASE 037 DATA=DATA:rec.delim;CALL DKXMTD(STATUS);IF NOT(OK) THEN GOSUB 10;*??? 038 END;9 RETURN 039 10 STATUS=-1 040 DATA=INSERT(DATA,1;"K":ID); *PICK/Ultimate 041 *INS ("K":ID) BEFORE DATA<1>;STATUS=-1; *Microdata 042 GO 9 043 * * * * * Interface info * * * * * 044 *Entry: STATUS := 1 means first entry to retrieve data 045 * 0 means subsequent entry; return next record 046 * 047 *Exit: On INITIAL.ENTRY On subsequent entries 048 * ---------------- --------------------- 049 * STATUS := 1 means data ok 1 means last record 050 * 0 means more to go 051 * -----------------On either------------------- 052 * <0 means K-msg err id VM filler in DATA 053 *Uses: NFN := 1 means Normalized File Names in the 054 * Kermit sense 055 * * * * * Revision history * * * * * 056 *.0 - 1/23/89 JF3 057 END DKOPNFILE 001 SUBROUTINE (STATUS) 002 *Open a file for processing 003 *7/20/87 JF3 0.3.0 004 !]OPENFILE 005 COM X1(44),Data.FV,Data.file.name;EQU file.type TO STATUS 006 *EQU F.REALLOC TO D.CODE;*Microdata 007 IF Data.file.name[1,5]="DICT " THEN 008 dict="DICT";dictname=Data.file.name[6,99] 009 END ELSE dict="";dictname=Data.file.name 010 * * * * * Ultimate/PICK * * * * * 011 filename=FIELD(dictname,",",2) 012 IF filename="" THEN 013 filename=dictname 014 END ELSE dictname=FIELD(dictname,",",1);dict=dictname 015 * * * * * Microdata * * * * * 016 *filename=dictname 017 * * * * * * * * * * * * * * * * 018 D.CODE=OCONV(dictname,"TMD;X;;1");file.type=D.CODE[1,1] 019 IF file.type#"D" AND file.type#"Q" THEN STATUS=-1;GO 9 020 OPEN dict,filename TO Data.FV ELSE STATUS=-1;GO 9 021 D.CODE=OCONV(filename,"TDICT ":dictname:";X;;1"); *PICK/Ultimate 022 IF D.CODE="DC" THEN file.type=1 ELSE file.type=0; *PICK/Ultimate 023 *F.REALLOC=OCONV("DL/ID","T*":filename:";X;;13"); *Microdata 024 *IF F.REALLOC[1,1]="B" THEN file.type=1 ELSE file.type=0;*Microdata 025 9 RETURN 026 * * * * * Interface info * * * * * 027 *Entry: Data.file.name := {DICT }filename ;*any implementation 028 * {dictname,}filename ;*Ultimate/PICK only 029 * 030 *Exit: STATUS := -1 means no go; 031 * 0 means ordinary file 032 * 1 means catalog pointer file 033 * Data.FV := data file variable 034 * Data.file.name := as in Entry. 035 * * * * * Revision history * * * * * 036 *.0 - 7/20/87 JF3 037 END DKSEND 001 SUBROUTINE (STATUS) 002 *Send file item(s) 003 *8/12/87 JF3 0.3.0 004 !]DKRETR]DKFNAME]DKCNV]DKIO]DKXMTt 005 COM CMD.LINE,X1,ERR,X2,n,DATA,X3(30),r,X4(3),ID,X5(2),f.name,FV 006 EQU LF TO CHAR(10),CR TO CHAR(13),SPACE TO " ",OK TO STATUS 007 EQU VM TO CHAR(253),AM TO CHAR(254),DONE TO STATUS 008 *ECHO.OFF=OCONV(0,"U80E0");*Microdata 009 ECHO OFF; *PICK/Ultimate 010 SELECTED=0;initial=0;LOOP 011 IF initial THEN 012 IF SELECTED THEN 013 2 READNEXT ID ELSE ID="" 014 f.name="";GO 3 015 END ELSE ID="" 016 END ELSE ID=FIELD(CMD.LINE<1>,SPACE,2);f.name=FIELD(CMD.LINE<1>,SPACE,3) 017 IF ID="*" AND NOT(initial) THEN SELECT FV;SELECTED=1;GO 2 018 3 UNTIL ID="" DO 019 STATUS=1;CALL DKRETR(STATUS);IF NOT(OK) THEN GOSUB 7 020 IF NOT(initial) THEN pkt.type="S";n=0;r=0;GOSUB 5;initial=1 021 CALL DKFNAME;DATA=f.name 022 pkt.type="F";GOSUB 5;ATTRS=0;*CALL DKCNV(ATTRS,0,-26:AM:3) 023 IF ATTRS THEN CALL DKXMTA(STATUS) ELSE OK=1 024 IF OK THEN 025 STATUS=0;LOOP CALL DKRETR(STATUS) UNTIL DONE DO 026 CALL DKXMTD(STATUS);GOSUB 6;STATUS=0 027 REPEAT;pkt.type="Z";GOSUB 5 028 END 029 REPEAT;pkt.type="B";GOSUB 5;STATUS=1;GO 9 030 5 subr="DKXMT":pkt.type;CALL @subr(STATUS) 031 6 IF OK>0 THEN n=MOD(n+1,64);r=0;RETURN 032 *Set correct mode here. 033 7 DATA="K5":AM:"Send":VM:DATA;RETURN TO 8 034 8 CALL DKIO("!");STATUS=-1;9 RETURN 035 * * * * * Interface info * * * * * 036 * Entry: 037 * CMD.LINE := SEND [ item-id ] . . . 038 * [ * ] 039 * [ entry# ] 040 * 041 * Exit : 042 * STATUS := 1 means finished ok 043 * := 0 " error; transaction terminated 044 * FILE.NAME<1>:= file name as entered 045 * <2>:= file type: nul means regular data file 046 * "P" means spooler PRINTFILE 047 * * * * * Revision history * * * * * 048 *.0 - 8/12/87 JF3 049 END DKFPKT 001 SUBROUTINE (TYPE) 002 *Form a PacKeT 003 *7/21/87 JF3 0.3.0 004 *]DKCNV]DKCTL]DKCHECK 005 COM X1(3),MARK,PKT.SEQ,PACKET,CHECK,X2(9) 006 COM MAXL,X3(5),QBIN,CHKT,REPT,X4(28),SQCTL;EQU STATUS TO TYPE 007 EQU test.len TO r.prefix,max.len TO r.prefix 008 p=CHKT+4;l=TYPE[1,1];IF l="Y" THEN l=TYPE[2,1] 009 IF l="A" OR l="I" OR l="S" THEN 010 data=PACKET;l=LEN(data);p=p+l;TYPE=TYPE[1,1];GO 5 011 END;data="";l=0;r=1;LOOP c=PACKET[l+1,1] UNTIL c="" DO 012 IF REPT="" THEN r.prefix="" ELSE 013 r=l+2;max.len=l+94 014 LOOP WHILE PACKET[r,1]=c AND r<max.len DO r=r+1 REPEAT 015 r=r-l-1;IF r>3 THEN 016 s=r;CALL DKCNV(s,1,0);r.prefix=REPT:s 017 END ELSE r.prefix="";r=1 018 END;s=SEQ(c);IF s>=128 THEN 019 s=s-128;c=CHAR(s);IF QBIN#"" THEN r.prefix=r.prefix:QBIN 020 END;IF s<=31 OR s=127 THEN CALL DKCTL(c);c=SQCTL:c ELSE 021 IF c=SQCTL THEN c=SQCTL:SQCTL ELSE 022 IF QBIN#"" AND c=QBIN THEN c=SQCTL:QBIN 023 IF c=REPT THEN c=SQCTL:REPT 024 END;END;c=r.prefix:c;lc=LEN(c);test.len=p+lc 025 IF test.len>MAXL THEN GO 5 ELSE data=data:c;l=l+r;p=test.len 026 REPEAT;IF l=0 THEN l=-1 027 5 PACKET=MARK:CHAR(p+30):CHAR(PKT.SEQ+32):TYPE:data 028 CHECK=0;CALL DKCHECK(CHECK);STATUS=(CHECK#"")*l;RETURN 029 * * * * * Interface info * * * * * 030 *Entry: TYPE := Protocol packet type or Yx where: 031 * x=S means Send-init ack packet 032 * x=I " server Init ack, or 033 * x=A " file Attribute ack. 034 * PACKET := contains DATA field of packet 035 * 036 *Exit: STATUS := >0 means length of packet 037 * 0 " packet cannot be checksumed 038 * <0 " data field is nul 039 * * * * * Revision history * * * * * 040 *.0 - 7/21/87 JF3 041 END DKRCVT 001 *DUMMY 002 *Subroutine list for DKRCVt type subs 003 *4/1/87 JF3 0.3.0 004 *]DKRCVS]DKRCVF]DKRCVA]DKRCVD]DKRCVZ]DKRCVB 005 END DKDPKT 001 SUBROUTINE (STATUS) 002 *Decode a packet 003 *1/29/87 JF3 0.3.0 004 *]DKCNV]DKDBUG 005 COM X1(5),DATA,X2(3),DEBUG.MODE,X3(11),QCTL,QBIN,CHKT,REPT 006 EQU L TO STATUS 007 PACKET=DATA;DATA="";L=0;R=0;BIT8=0;LOOP GOSUB 6 UNTIL C="" DO 008 BEGIN CASE 009 CASE C=REPT;IF R THEN GO 9 ELSE GOSUB 6;CALL DKCNV(C,-1,0);R=C 010 CASE C=QBIN;IF BIT8 THEN GO 9 ELSE BIT8=1 011 CASE C=QCTL;GOSUB 6;BEGIN CASE 012 CASE C=QCTL;CASE C=QBIN;CASE C=REPT 013 CASE 1;C=CHAR(SEQ(C)-64) 014 END CASE;GO 4 015 CASE 1 016 4 IF BIT8 THEN C=CHAR(SEQ(C)+128);BIT8=0;*SM invalid for file data! 017 IF R THEN C=STR(C,R);R=0 018 DATA=DATA:C 019 CASE 0 020 6 L=L+1;C=PACKET[L,1];RETURN 021 END CASE 022 REPEAT;L=L-1;IF L=0 THEN L=-1 023 IF DEBUG.MODE THEN 024 R=L;STATUS="D";PACKET=DATA;C=LEN(DATA)+2+CHKT;CALL DKCNV(C,1,0) 025 DATA=CHAR(0):C:" ":DATA:STR(" ",CHKT);CALL DKDBUG(STATUS) 026 DATA=PACKET;L=R;END;8 RETURN 027 9 STATUS=0;GO 8 028 * * * * * Interface info * * * * * 029 *Entry: DATA contains received packet data field 030 * 031 *Exit: DATA contains expanded data 032 * * * * * Revision history * * * * * 033 *.0 1/29/87 JF3 034 END DKcnv 001 *DUMMY 002 *Subroutine list for custom parameter conversion routines 003 *7/14/87 JF3 0.3 004 *]DKDF]DKFA 005 END DKVERC 001 SUBROUTINE (STATUS) 002 *VERify a command as valid 003 *6/25/87 JF3 0.3.0 004 *]DKPARSE]DKIO 005 COM X1(5),data,X2(5),PARAMS,X3(52),i(3) 006 EQU CMD TO STATUS,ok TO STATUS,c TO i(1) 007 IF CMD[1,1]="!" THEN CMD=CMD[2,99];c=1 ELSE 008 MAT i=0;CALL DKPARSE(CMD,2) 009 END;IF c THEN 010 data="DK":CMD;v=1;ok=0;LOOP conv.code=PARAMS<14,v> UNTIL conv.code="" DO 011 ok=(PARAMS<15,v>=OCONV(data,conv.code)) 012 IF ok THEN GO 9 ELSE v=v+1 013 REPEAT;data="DKverb: ":data 014 END ELSE data="command: ":CMD 015 data=INSERT(data,1,0,0,"K1");STATUS="!";CALL DKIO(STATUS);STATUS=-1 016 9 RETURN 017 * * * * * Interface info * * * * * 018 *Entry : CMD := all caps command token 019 * 020 *Exit: STATUS := -1 invalid command 021 * 1 means command ok; DKcommand in data 022 * * * * * Revision history * * * * * 023 *.0 - 6/25/87 JF3 024 END DKRCVA 001 SUBROUTINE (STATUS) 002 *Receive a file Attribute packet -- NOT USED in 0.3 003 *7/14/87 JF3 004 *]DKCNV]DKAnn 005 COM X1(5),DATA,X2(5),PARAMS;EQU AM TO CHAR(254),OK TO STATUS 006 DIM ack.attrs(2);MAT ack.attrs="" 007 s=1;LOOP ATTR=DATA[s,1] UNTIL ATTR="" DO 008 attr.no=ATTR;CALL DKCNV(attr.no,-1,0) 009 sLENGTH=DATA[s+1,1];CALL DKCNV(sLENGTH,-1,0);sDATA=DATA[s+2,sLENGTH] 010 p=11;LOOP 011 * LOCATE attr.no IN PARAMS<p>,1 SETTING w ELSE w=-1;*Microdata/Ultimate 012 LOCATE(attr.no,PARAMS<p>;w) ELSE w=-1; *PICK 013 IF w>0 THEN 014 IF p=11 THEN 015 subroutine="DKA":(100+attr.no)[2,2];STATUS=sDATA 016 CALL @subroutine(STATUS);IF STATUS>1 THEN w=OK ELSE w=NOT(OK) 017 END ELSE w=0 018 END ELSE 019 IF p=12 THEN w=2 020 END 021 WHILE w=-1 DO p=p+1 REPEAT 022 IF w THEN ack.attrs(w)=ack.attrs(w):ATTR 023 s=s+2+sLENGTH;REPEAT;IF ack.attrs(1)="" THEN DATA="Y";w=2 ELSE DATA="N";w=1 024 DATA=DATA:ack.attrs(w);STATUS=1;RETURN 025 * * * * * Interface info * * * * * 026 *Entry: DATA := File Attribute packet per Kermit Protocol Manual 027 * each DATA field containing (optionally) many subfields 028 * 029 *Exit: DATA := data field of ack packet 030 * 031 *Uses: ack.attrs(1) := N{xxx} list 032 * (2) := Y{xxx} list 033 * * * * * Revision history * * * * * 034 *.0 - 7/14/87 JF3 035 END DKSET 001 SUBROUTINE (STATUS) 002 *SET kermit parameters 003 *7/24/87 JF3 0.3.0 004 *]DKCNV]DKPARSE]DKIO]GTRMCHR 005 COM P(64),i(3);EQU SPACE TO " ",a TO i(1),v TO i(2),s TO i(3) 006 EQU CMD.LINE TO P(1),ERR TO P(3),PAR.LIST TO P(12),DICT.DK TO P(15) 007 EQU MSG TO P(6),help.request TO i(2);par=OCONV(CMD.LINE<1>,"G1 1") 008 help.request=(par="?");IF help.request THEN 009 * Get terminal width below 010 CALL GTRMCHR(MSG);s=INT(OCONV(MSG<4>,"G,1")/2);s="L#":s 011 v=1;MSG="";LOOP GOSUB 10 UNTIL par="" DO 012 GOSUB 10;STATUS=-1;CALL DKIO(STATUS);MSG="" 013 REPEAT;STATUS=1 014 END ELSE 015 a=2;v=0;CALL DKPARSE(par,12);IF v THEN 016 IF PAR.LIST<8,v>="" THEN p=2 ELSE 017 p=3;a=8;subpar=OCONV(CMD.LINE<1>,"G2 1");CALL DKPARSE(subpar,12) 018 IF NOT(s) THEN MSG="subparameter: ":subpar;GO 4 019 END;arg=OCONV(CMD.LINE<1>,"G":p:" 99");cnv=PAR.LIST<5,v> 020 IF NOT(NUM(cnv)) THEN cnv<1,2>="1" 021 idx=PAR.LIST<3,v>;idx<2>=PAR.LIST<9,v,s> 022 CALL DKCNV(arg,cnv,idx);IF arg="!!!" THEN 023 P(6)=cnv;CALL DKIO("!");STATUS=-1 024 END ELSE STATUS=1 025 END ELSE 026 MSG="parameter: ":par 027 4 MSG=INSERT(MSG,1,0,0,"K1");CALL DKIO("!");STATUS=-1 028 END 029 END;RETURN 030 10 par=PAR.LIST<2,v>;MSG=MSG:(par:SPACE:PAR.LIST<6,v>)s 031 v=v+1;RETURN 032 * * * * * Interface info * * * * * 033 * Entry: 034 * CMD.LINE := SET [parameter {subparameter }value] 035 * [? ] 036 * 037 * Exit: 038 * STATUS := 1 means finished ok 039 * * * * * Revision history * * * * * 040 *.0 - 7/14/87 JF3 041 END DKRETRY 001 SUBROUTINE (status) 002 *increment RETRY counter and check against limit 003 *7/21/87 JF3 0.3 004 *]DKERR]DKFPKT]DKIO 005 COM X1(8),LIMIT,X2(27),r;EQU OK TO status,AM TO CHAR(254) 006 r=r+1;IF r<LIMIT THEN status=1 ELSE 007 DATA="K3":AM:LIMIT;CALL DKERR;status="E";CALL DKFPKT(status) 008 IF OK THEN CALL DKIO(-2);status=0 009 END;RETURN 010 * * * * * Interface info * * * * * 011 *Entry: none 012 * 013 *Exit: status := 1 means retry counter incremented 014 * := 0 " error packet sent, transaction terminated 015 * * * * * Revision history * * * * * 016 *.0 - 7/21/87 JF3 017 END DKRCVB 001 SUBROUTINE (STATUS) 002 *Receive an Break packet 003 *7/17/89 JF3 0.3.1 004 ! 005 STATUS=0 006 *ECHO.ON=OCONV(0,"U70E0");*Microdata 007 ECHO ON; *PICK/Ultimate 008 RETURN 009 * * * * * Interface Info * * * * * 010 * 011 *Entry: none 012 * 013 *Exit: ECHO set ON; STATUS reset 014 * * * * * Revision history * * * * * 015 *.1 - 7/17/89 JF3 Set ECHO back on after transaction 016 * 017 *.0 - 1/29/87 JF3 018 END DKRCVZ 001 SUBROUTINE (STATUS) 002 *Receive an End-of-file packet 003 *10/22/88 JF3 0.3.0 004 *]DKSTOR 005 COM X1(33),F.TYPE,X2,RECORD,X3(4),FILE.NAME,ITEM,X4,LOCAL.FILE.SPEC,FV 006 EQU OK TO STATUS 007 IF RECORD="" THEN STATUS=1 ELSE CALL DKSTOR(STATUS) 008 IF OK THEN 009 BEGIN CASE 010 CASE F.TYPE<2 011 IF LOCAL.FILE.SPEC="" THEN id=FILE.NAME ELSE id=LOCAL.FILE.SPEC 012 WRITE ITEM ON FV,id;*EXECUTE "MSG !0 '":id:"'" 013 IF F.TYPE=1 THEN NULL;*CLEAN UP POINTER-FILE DATA 014 CASE F.TYPE=2 015 CASE F.TYPE=3;PRINTER CLOSE 016 END CASE 017 END;RETURN 018 * * * * * Interface info * * * * * 019 *Entry: RECORD := any remnant of received file 020 * * * * * Revision history * * * * * 021 *.0 - 10/22/88 JF3 022 END DKA01 001 SUBROUTINE (STATUS) 002 *check received Attribute 1 (length) -- NOT USED in 0.3 003 *7/14/87 JF3 004 * 005 COM X1(33),DATAFILE.TYPE;EQU Length TO STATUS 006 IF DATAFILE.TYPE=0 THEN 007 IF (Length+0)>32 THEN STATUS=0 008 END ELSE STATUS=1 009 RETURN 010 * * * * * Interface info * * * * * 011 *See DKAnn 012 * * * * * Revision history * * * * * 013 *.0 - 7/14/87 JF3 014 END DKSTOR 001 SUBROUTINE (STATUS) 002 *STOre received Record into system 003 *10/22/88 JF3 0.3.0 004 * 005 COM X1(29),MAX.REC.LEN,X2(3),PICK.file.type,a,RECORD,X3(5) 006 COM ITEM,X4(3),DATAFILE,X5(16),F.FORMAT 007 IF MAX.REC.LEN AND LEN(RECORD)>MAX.REC.LEN THEN STATUS=0 ELSE 008 * Undefined if DATAFILE is null; should be fixed! 009 IF DATAFILE="" THEN 010 BEGIN CASE 011 CASE DISP="";GO 5 012 CASE DISP="O";CASE DISP="S" 013 CASE DISP="P";GO 30 014 CASE DISP="T";GO 20 015 CASE DISP="L";CASE DISP="X" 016 CASE DISP="A";GO 10 017 END CASE 018 END ELSE 019 BEGIN CASE 020 CASE PICK.file.type=0 021 5 IF F.FORMAT="I" THEN ITEM=ITEM:RECORD ELSE ITEM<a>=RECORD 022 CASE PICK.file.type=1 023 10 *Put RECORD to catalog space 024 CASE PICK.file.type=2 025 20 *Put RECORD into ABS space 026 CASE PICK.file.type=3 027 30 PRINTER ON;PRINT RECORD;PRINTER OFF;RETURN 028 END CASE 029 END;a=a+1;RECORD="";STATUS=1 030 END;RETURN 031 * * * * * Interface info * * * * * 032 * * * * * Revision history * * * * * 033 *.0 - 10/22/88 JF3 034 END DKA02 001 SUBROUTINE (STATUS) 002 *check received Attribute 2 (type) -- NOT USED in 0.3 003 *7/21/87 JF3 004 * 005 COM X1(63),Type 006 EQU DATA TO STATUS 007 type=DATA[1,1];STATUS=1 008 BEGIN CASE 009 CASE type="A" 010 CASE type="B" 011 CASE type="D" 012 CASE type="F" 013 CASE type="I" 014 CASE 1;STATUS=0;GO 9 015 END CASE;arg=DATA[2,l];IF l=1 THEN 016 IF NUM(arg) THEN cnv=0 ELSE cnv=-1 017 CALL DKCNV(arg,cnv,ix) 018 END;8 STATUS=1;9 RETURN 019 * * * * * Interface info * * * * * 020 *See DKAnn 021 * * * * * Revision history * * * * * 022 *.0 - 7/21/87 JF3 023 END DKRCVD 001 SUBROUTINE (STATUS) 002 *ReCeiVe a Data packet 003 *10/22/88 JF3 0.3.0 004 *]DKDPKT]DKSTOR 005 COM X1(5),DATA,X2(23),MAX.REC.LEN,p1,len.REC.TERM,X3(2),a,record 006 COM X4(6),REC.TERMINATION,X5(18),l,F.FORMAT,X6;EQU OK TO STATUS 007 EQU REC.SIZE.LEN TO REC.TERMINATION,REC.SIZE TO REC.TERMINATION 008 IF a=1 THEN 009 BEGIN CASE 010 CASE F.FORMAT="";GO 1;F.FORMAT="A";REC.TERMINATION="";GO 2 011 CASE F.FORMAT="A";GO 2 012 CASE F.FORMAT="D";len.REC.TERM=0 013 CASE F.FORMAT="F";len.REC.TERM=0;p1=1;l=REC.SIZE 014 CASE 1 015 1 F.FORMAT="A";REC.TERMINATION=CHAR(13):CHAR(10) 016 2 len.REC.TERM=LEN(REC.TERMINATION);p1=1 017 END CASE 018 END;CALL DKDPKT(STATUS);rec.complete=0 019 IF F.FORMAT="A" THEN DATA=record:DATA 020 LOOP 021 IF F.FORMAT="I" THEN record=DATA;DATA="";rec.complete=1 ELSE 022 len.DATA=LEN(DATA);BEGIN CASE 023 CASE F.FORMAT="A" 024 p2=INDEX(DATA,REC.TERMINATION,1);record="" 025 IF p2 THEN rec.complete=1;p2=p2-1 ELSE p2=len.DATA 026 CASE F.FORMAT="D" 027 IF l THEN p1=1 ELSE 028 l=DATA[1,REC.SIZE.LEN]-REC.SIZE.LEN;p1=REC.SIZE.LEN+1 029 END;GO 3 030 CASE F.FORMAT="F" 031 3 rec.complete=(l<=len.DATA);p2=l 032 END CASE;record=record:DATA[p1,p2] 033 DATA=DATA[p1+p2+len.REC.TERM,9999] 034 END 035 UNTIL DATA="" DO 036 GOSUB 5;IF NOT(OK) THEN GO 9 037 REPEAT;IF rec.complete THEN 038 5 CALL DKSTOR(STATUS);IF OK THEN 039 rec.complete=0;IF F.FORMAT="F" THEN l=REC.SIZE ELSE l=0 040 END 041 END ELSE l=l-(len.DATA-(p1-1));STATUS=1 042 9 RETURN 043 * * * * * Interface Info * * * * * 044 *Uses: l Set to 0 by DKRCVF; generally means # chars 045 * remaining to complete a record. 046 * * * * * Revision history * * * * * 047 *.0 - 10/22/88 JF3 048 END DKSHOW 001 SUBROUTINE (STATUS) 002 *SHOW parameters somewhere 003 *8/7/87 JF3 0.3.0 004 *]DKCNV]DKPARSE]DKIO 005 COM P(64),i(3);EQU a TO i(1),p TO i(2),s TO i(3) 006 EQU CMD.LINE TO P(1),MSG TO P(6),PAR.LIST TO P(12),REMOTE.CTRL TO P(40) 007 EQU cr TO CHAR(13),lf TO CHAR(10);CALL GTRMCHR(MSG);MSG=MSG<4> 008 LINES.PAGE=FIELD(MSG,",",2);CHARS.LINE=FIELD(MSG,",",1)+1;P(41)="ALL" 009 COLS=INT(CHARS.LINE/26);a=2;s=0 010 FMT="L#":INT((CHARS.LINE-1)/COLS); *Microdata/PICK 011 *FMT="L(#":INT((CHARS.LINE-1)/COLS):")";*Ultimate 012 I.PARAM=FIELD(CMD.LINE<1>," ",2);STATUS=1;L=1;C=1;p=0;t=999 013 CALL DKPARSE(I.PARAM,12);IF p THEN 014 SUB.PARAM=FIELD(CMD.LINE<1>," ",3);IF SUB.PARAM#"" THEN 015 a=8;CALL DKPARSE(SUB.PARAM,12) 016 IF s THEN t=s;GOSUB 11 ELSE MSG="subparameter: ":SUB.PARAM;GO 6 017 END ELSE GOSUB 10 018 END ELSE 019 a=1;p=0;CALL DKPARSE(I.PARAM,41);IF p THEN 020 p=0 021 LOOP p=p+1;I.PARAM=PAR.LIST<2,p> UNTIL I.PARAM="" DO GOSUB 10 REPEAT 022 END ELSE 023 MSG="parameter: ":I.PARAM 024 6 MSG=INSERT(MSG,1,0,0,"K1");STATUS="!";GO 20 025 END 026 END;9 MSG="";STATUS=-1;GO 20 027 10 s=1;11 index=-PAR.LIST<3,p>;cnv=PAR.LIST<5,p> 028 IF NUM(cnv) THEN cnv=-cnv ELSE cnv<1,2>="-1" 029 LOOP SUB.PARAM=PAR.LIST<8,p,s> UNTIL (SUB.PARAM="" AND s>1) OR s>t DO 030 IF SUB.PARAM#"" THEN index<2>=PAR.LIST<9,p,s>;SUB.PARAM=" ":SUB.PARAM 031 SUB.PARAM=SUB.PARAM:"=";CALL DKCNV(arg,cnv,index) 032 IF L>LINES.PAGE AND REMOTE.CTRL<3 THEN 033 MSG="K8";STATUS="!";GOSUB 20 034 IF STATUS THEN L=1;C=1 ELSE STATUS=1;RETURN TO 9 035 END;MSG=I.PARAM:SUB.PARAM:arg 036 IF C=COLS THEN STATUS=-1;C=1;L=L+1 ELSE 037 MSG=MSG FMT;STATUS=-(REMOTE.CTRL=3);C=C+1 038 END;GOSUB 20 039 s=s+1;REPEAT;RETURN 040 20 CALL DKIO(STATUS);RETURN 041 * * * * * Interface info * * * * * 042 * Entry: 043 * PAR.LIST := <2,p> parameter p name 044 * := <3,p> COM position 045 * := <5,p> conversion type/subr name 046 * Exit: 047 * STATUS := 1 means finished ok 048 * * * * * Revision history * * * * * 049 *.0 - 8/7/87 JF3 050 END DKIO 001 SUBROUTINE (STATUS) 002 *Input/Output operations 003 *11/4/88 JF3 0.3.1 004 !]DKERR]DKDBUG]DKINP 005 COM P(64);EQU ERR TO P(3),DATA TO P(6),DEBUG.MODE TO P(10),EOL TO P(21) 006 EQU CMD.PROMPT TO P(33),LINE TO P(38),REMOTE.CTRL TO P(40) 007 IF STATUS="!" THEN CALL DKERR;STATUS=-1 008 IF DATA#"" THEN 009 BEGIN CASE 010 CASE REMOTE.CTRL=3 AND STATUS=-1 011 IF LINE#"" THEN EXECUTE "MSG !":LINE:" ":DATA 012 CASE STATUS#3 013 PRINT DATA:;IF DEBUG.MODE>0 THEN CALL DKDBUG("S") 014 END CASE 015 END;IF STATUS>0 THEN 016 IF STATUS=1 THEN PROMPT CMD.PROMPT<4> 017 a=ABS(REMOTE.CTRL);IF REMOTE.CTRL="" OR a=1 OR a=2 THEN 018 IF STATUS>1 THEN STATUS=0;*PICK/Ultimate 019 * STATUS=1 *Microdata 020 IF a=1 THEN 021 * ECHO.ON=OCONV("","U70E0");*Microdata 022 ECHO ON ;*PICK/Ultimate 023 END;CALL DKINP(STATUS);STATUS=(DATA#"") 024 IF DEBUG.MODE>0 THEN CALL DKDBUG("R") 025 END 026 END;IF STATUS=0 OR REMOTE.CTRL=3 THEN STATUS=1 ELSE 027 IF STATUS=-1 THEN PRINT 028 IF STATUS=-2 THEN PRINT EOL: 029 END;RETURN 030 * * * * * Interface info * * * * * 031 *Entry: 032 * STATUS := 1 means pause for input & reset prompt char 033 * := 2 " " " " but no new prompt 034 * := 3 " pause for input & no output at all 035 * := 0 " no pause 036 * := -1 " no pause & cr/lf after output 037 * := -2 " no pause & terminate w/EOL 038 * 039 * LINE := alternate process #; 0 means none. 040 * 041 * REMOTE.CTRL := 3 means Batch mode | 042 * 2 " Server mode | MAIN 043 * 1 " Remote mode | PROCESS 044 * nul " Local mode - connected | 045 * 0 " Local mode - closed | 046 * ------------------------------------- 047 * -1 " Remote mode | 048 * -2 " Server mode | SUB 049 * -3 " closed connection (idle) | PROCESS 050 * 051 *Exit: 052 * STATUS := true means all went ok 053 * := false " timeout awaiting input (not implemented) 054 END 055 * * * * * Revision history * * * * * 056 *.1 11/4/88 JF3 Change DKinp to DKINP 057 * 058 *.0 8/13/87 JF3 DKRCVE 001 SUBROUTINE (STATUS) 002 *Receive a Error packet 003 *1/29/87 JF3 0.3.0 004 *]DKDPKT 005 CALL DKDPKT(STATUS);STATUS=-1;RETURN 006 * * * * * Interface info * * * * * 007 * * * * * Revision history * * * * * 008 *.0 - 1/29/87 JF3 DKPRMT 001 SUBROUTINE (arg,c,X) 002 *Convert prompt string -- NOT USED in 0.3 003 *7/21/87 JF3 0.3 004 * 005 COM X1(32),CMD.PROMPT 006 c=c<2>;IF c>0 THEN 007 l=LEN(arg);CMD.PROMPT=arg[1,l-1];CMD.PROMPT<2>=arg[l,1] 008 END ELSE 009 arg=CMD.PROMPT<1>:CMD.PROMPT<2> 010 END;c=0;RETURN 011 * * * * * Interface info * * * * * 012 *Entry: c<2> := >0 means convert from external (prompt-string prompt-char) 013 * to internal (CMD.PROMPT dynamic array) 014 * otherwise convert internal to external 015 * arg := data to convert from or into 016 * 017 *Exit: 018 * * * * * Revision history * * * * * 019 *.0 - 7/21/87 JF3 020 END DKFINISH 001 SUBROUTINE (STATUS) 002 *tell remote server to shut down; we are FINISHed -- NOT USED in 0.3 003 *8/7/87 JF3 004 COM X1(5),DATA 005 DATA="F";CALL DKXMTG(STATUS) 006 RETURN 007 * * * * * Interface info * * * * * 008 * * * * * Revision history * * * * * 009 *.0 - 8/7/87 JF3 010 END DKHELP 001 SUBROUTINE (STATUS) 002 *Display HELP info 003 *4/9/87 JF3 0.3 004 *]DKIO 005 COM X1,HELP.LIST,X2(3),LINE 006 C=2;LOOP LINE=HELP.LIST<C> UNTIL LINE="" DO 007 CALL DKIO(-1) 008 C=C+1;REPEAT;STATUS=1;RETURN 009 * * * * * Interface info * * * * * 010 *Entry: none 011 *Exit: none 012 * * * * * Revision history * * * * * 013 *.0 - 4/9/87 JF3 014 END DKRCVF 001 SUBROUTINE (STATUS) 002 *ReCeiVe a File name packet 003 *7/21/87 JF3 0.3.0 004 *]DKDPKT 005 COM X1(5),DATA,X2(27),f.type,A,C,X3(4),filename,item 006 COM X4(2),FV,FN,FID,X5(14),l 007 EQU OK TO STATUS,b TO " ",FF TO CHAR(12),DK1.3 TO STATUS,beg.fid TO STATUS 008 CALL DKDPKT(STATUS);filename=DATA 009 BEGIN CASE 010 CASE f.type<2 011 READ item FROM FV,filename ELSE item="" 012 IF f.type=0 THEN item="";*TEMP FOR SMS 013 IF f.type=1 THEN 014 DK1.3="U3":FID<1,1>;beg.fid=OCONV("",DK1.3) 015 IF beg.fid THEN 016 item<12>=beg.fid;item<13>=1 017 END 018 END 019 CASE f.type=3 020 PRINTER ON 021 PRINT 'FOLLOWING JOB RECEIVED AS FILE "':filename:'".':FF: 022 PRINTER OFF;DATA="PRINTFILE" 023 END CASE 024 A=1;C="";l=0 025 RETURN 026 * * * * * Interface info * * * * * 027 *Entry: 028 * * * * * Revision history * * * * * 029 *.0 - 7/21/87 JF3 030 END DKFA 001 SUBROUTINE (arg,c,index) 002 *Convert file attributes -- NOT USED in 0.3 003 *7/14/87 JF3 004 ! 005 COM X1(47),F.ATTRS 006 s=index<2> 007 *LOCATE s IN F.ATTRS<2> SETTING v ELSE arg="";GO 4;*Microdata/Ultimate 008 LOCATE(s,F.ATTRS,2;v) ELSE arg="";GO 4; *PICK 009 arg=F.ATTRS<1,v> 010 4 c=0;RETURN 011 * * * * * Interface info * * * * * 012 * Entry: 013 * 014 * Exit: 015 * * * * * Revision history * * * * * 016 *.0 - 7/14/87 JF3 017 END DKEXIT 001 SUBROUTINE (STATUS) 002 *Exit command 003 *6/30/87 JF3 0.3.0 004 ! 005 COM X1(39),REMOTE.CTRL 006 IF REMOTE.CTRL=3 THEN 007 * ECHO.ON=OCONV("","U80E0");*Microdata 008 ECHO ON; *PICK/Ultimate 009 END;STATUS=0;RETURN 010 * * * * * Interface info * * * * * 011 *Entry: none 012 *Exit: return to TCL 013 * * * * * Revision history * * * * * 014 *.0 - 6/30/87 JF3 015 END DKINP 001 SUBROUTINE (STATUS) 002 *INPut data (with timeout on NON Reality/Royale versions) 003 *11/4/88 JF3 0.3.2 004 ! 005 COM V(96);EQU DATA TO V(6),TIMEOUT TO V(18),EOL TO V(21) 006 *EQU S TO 11;*Ultimate 007 EQU S TO 14;*PICK 008 DATA="";IF STATUS THEN 009 INPUT DATA: 010 * * * * * PICK/Ultimate * * * * * 011 END ELSE 012 GOSUB 8;PROMPT"";PRINT EOL:;LOOP 013 LOOP N=SYSTEM(S) WHILE N DO 014 INPUT c,1:;IF c="" THEN c=EOL 015 DATA=DATA:c;IF c=EOL THEN STATUS=1;GO 9 016 IF N=1 THEN GOSUB 8 017 REPEAT 018 UNTIL TIME()>=t AND still.early DO 019 IF NOT(still.early) THEN GOSUB 8 020 REPEAT;STATUS=0 021 * * * * * * * * * * * * * * * 022 END;8 t=TIME();still.early=(t<86385);t=t+TIMEOUT 023 9 RETURN 024 * * * * * Interface info * * * * * 025 *Entry: STATUS := false means check timeout 026 * true " ordinary input 027 * PROMPT must be set by caller 028 * 029 *Exit: STATUS := false means timeout occured 030 * true " all ok 031 * DATA := any input including EOL char 032 * * * * * Revision history * * * * * 033 *.2 - 11/4/88 JF3 Fix midnight timeout problem. 034 * 035 *.1 - 12/29/87 JF3 Make SYSTEM(x) EQUatable. 036 * 037 *.0 - 1/29/87 JF3 038 END DKXMTS 001 SUBROUTINE (STATUS) 002 *XMiT a Send-init packet 003 *7/24/87 JF3 0.3.0 004 !]DKINIT]DKDBUG]DKXPKTS]DKRECON]DKRETRY 005 COM X1(3),MARK,n,DATA,X2,TYPE,X3,DEBUG.MODE,DELAY 006 *EQU TYPE TO STATUS,RECEIVER TO STATUS,OK TO STATUS;*ULTIMATE/Microdata 007 EQU RECEIVER TO STATUS,OK TO STATUS;*PICK 008 CALL DKINIT(OK);IF OK THEN 009 TYPE="S";CALL DKFPKT(TYPE);IF OK THEN 010 IF DEBUG.MODE THEN CALL DKDBUG("H") 011 * SLEEP=OCONV(DELAY,"U407A");*Microdata/Ultimate 012 SLEEP DELAY; *PICK 013 LOOP 014 RECEIVER=0;CALL DKXPKTS(RECEIVER);IF OK>0 THEN 015 BEGIN CASE 016 CASE TYPE="Y" 017 RECEIVER=0;CALL DKRECON(RECEIVER) 018 CASE TYPE="N";CALL DKRETRY;OK=0 019 END CASE 020 END ELSE CALL DKDBUG(STATUS);STOP 021 UNTIL OK DO REPEAT 022 END ELSE STATUS=0 023 END;RETURN 024 * * * * * Interface info * * * * * 025 *Entry: none 026 * 027 *Exit: STATUS := true means both sides configured 028 * false means error occured somewhere. 029 * * * * * Revision history * * * * * 030 *.0 - 7/24/87 JF3 031 END DKFNAME 001 SUBROUTINE DKFNAME 002 *setup File NAMEs (in Kermit sense) 003 *7/8/87 JF3 0.3.0 004 *]DKCNV]DKNFN 005 COM X1(16),MAXL,X2(6),CHKT,X3(16),ID,X4(2) 006 COM F.NAME,X5,filename.type;DIM N(3) 007 EQU name TO N(1),type TO N(2),sep TO N(3),AM TO CHAR(254) 008 name=filename.type<1>;type=filename.type<2>;sep="" 009 CALL DKCNV(NFN,0,-48:AM:105);NFN=(NFN[1,6]="NORMAL") 010 IF F.NAME="" THEN 011 BEGIN CASE 012 CASE type<2 013 IF NFN THEN type=name ELSE type="" 014 name=ID 015 * CASE type=2;type="";sep=".";*Not used. 016 CASE type=3;type=(1000+ID)[2,3] 017 CASE 1;F.NAME="";GO 9 018 END CASE 019 END ELSE 020 type=INDEX(F.NAME,".",1);IF type THEN 021 name=F.NAME[1,type-1];type=F.NAME[type+1,9999];sep="." 022 END ELSE name=F.NAME;type="" 023 END;IF NFN THEN CALL DKNFN(MAT N) 024 F.NAME=(name:sep:type)[1,MAXL-2-CHKT] 025 9 RETURN 026 * * * * * Interface info * * * * * 027 *Entry: filename.type <1> := file name SET by command 028 * <2> := file type # SET by command 029 *Uses: NFN := Normalized File Names 030 * sep := file name seperator 031 *Exit: F.NAME := filename to be used in transaction 032 * * * * * Revision history * * * * * 033 *.0 - 7/8/87 JF3 034 END DKRECON 001 SUBROUTINE (STATUS) 002 *Reconcile initial packet parameters 003 *10/24/88 JF3 0.3.1 004 *]DKQUOT]DKCNV 005 COM X1(5),DATA,X2(16),QBIN;EQU RX TO STATUS 006 AckPkt="";f=1;c=1;LOOP F=DATA[c,1] UNTIL F="" OR f=10 DO 007 p=(16+f);EOL=(f=5);CAPAS=(f=10);ix=p*(EOL OR CAPAS) 008 BEGIN CASE;CASE f=4;cnv=4 009 CASE CAPAS;S=F;LOOP WHILE MOD(SEQ(S),2) DO 010 c=c+1;S=DATA[c,1];F=F:S;REPEAT;cnv="CAPAS";cnv<1,2>=-1 011 CASE 5<f AND f<10;cnv=0;CALL DKQUOT(RX,f,F) 012 CASE 1;cnv=1;END CASE;IF NUM(cnv) THEN icnv=-cnv ELSE icnv=cnv 013 CALL DKCNV(F,icnv,ix);IF EOL THEN CALL DKCNV(F,3,p) 014 IF RX THEN 015 IF EOL THEN cnv=-3 016 IF CAPAS THEN cnv<1,2>=1 017 IF f=7 THEN 018 IF NOT(F="N" OR F=QBIN) THEN F="Y" 019 END ELSE 020 IF f=4 THEN cnv=3 021 CALL DKCNV(F,cnv,-(48+f)) 022 IF f=4 THEN cnv=4;GO 7 023 IF EOL THEN 024 cnv=1;7 CALL DKCNV(F,cnv,0) 025 END;END;AckPkt=AckPkt:F 026 END;f=f+1;c=c+1 027 REPEAT;IF RX THEN DATA=AckPkt 028 STATUS=1;RETURN 029 * * * * * Interface info * * * * * 030 * Entry: 031 * STATUS := 1 means Receive mode 032 * DATA := DATA field of received init (S or Y) packet 033 * Exit: 034 * If Receive mode then DATA contains DATA field of Ack packet 035 * * * * * Revision history * * * * * 036 *.1 - 10/24/88 JF3 037 * 038 *.0 - 1/29/87 JF3 039 END DKBATCH 001 SUBROUTINE (STATUS) 002 *go into BATCH mode 003 *8/7/87 JF3 0.3.0 004 *]DKRCVG]DKXPKTS]DKRCVt 005 COM command.line,X1(4),msg,X2(31),process,X3,remote.control 006 *IF remote.control THEN 007 *END ELSE 008 process=FIELD(command.line<1>," ",2);IF NUM(process) THEN 009 *check for logged on process here 010 msg="K21";STATUS="!";CALL DKIO(STATUS);remote.control=3 011 command.line="" 012 * ECHO.OFF=OCONV("","U80E0");*Microdata 013 ECHO OFF; *PICK/Ulitmate 014 END ELSE msg="K1";msg<2>="process#";STATUS="!";CALL DKIO(STATUS) 015 *END 016 STATUS=1;RETURN 017 * * * * * Interface info * * * * * 018 *Entry: none 019 * 020 *Exit: remote.control := set to remote command mode = "3" 021 * * * * * Revision history * * * * * 022 *.0 - 8/7/87 JF3 023 END DKCAPAS 001 SUBROUTINE (arg,c,X) 002 *Convert CAPAS bit fields -- NOT USED in 0.3 003 *2/6/87 JF3 004 *]DKCNV 005 DIM C(9);MAT C=0;I=0 006 BEGIN CASE 007 CASE c=1 008 v=1;LOOP P=arg<1,v> UNTIL P="" DO 009 IF P THEN 010 P=arg<2,v>-1;i=INT(P/5)+1;P=5*i-P 011 C(i)=C(i)+PWR(2,P);IF i>I THEN I=i 012 END;v=v+1 013 REPEAT;arg="";FOR i=1 TO I 014 C(i)=C(i)+(I>i);CALL DKCNV(C(i),1,0);arg=arg:C(i) 015 NEXT i 016 CASE c=-1 017 I=LEN(arg);int.arg="";FOR i=1 TO I 018 P=arg[i,1];CALL DKCNV(P,-1,0);FOR p=5 TO 1 STEP -1 019 v=PWR(2,p);bit=(P>=v);IF bit THEN P=P-v 020 v=5*i-p+1;int.arg<2,v>=v;int.arg<1,v>=bit 021 NEXT p 022 NEXT i;arg=int.arg 023 END CASE;c=0;RETURN 024 * * * * * Interface info * * * * * 025 * Entry: 026 * if c=1 then convert from internal to packet formats 027 * arg<1>:= multivalued bit fields 028 * <2>:= associated field #s 029 * if c=-1 then convert from packet to internal formats 030 * arg := char string from packet CAPAS field 031 * Exit: 032 * if c=1 on entry then 033 * arg := char() encoded string 034 * if c=-1 on entry then 035 * arg<1> :=} as above 036 * arg<2> :=} 037 * c := 0 038 * * * * * Revision history * * * * * 039 *.0 - 2/6/87 JF3 040 END DKXMTT 001 *DUMMY 002 *Subroutine list for DKXMTt subroutine names 003 *4/3/87 JF3 0.3 004 *]DKXMTS]DKXMTF]DKXMTA]DKXMTD]DKXMTZ]DKXMTB 005 END DKCHECK 001 SUBROUTINE (check) 002 *Checksum a packet 003 *4/9/87 JF3 0.3.0 004 *]DKCNV 005 COM X1(5),DATA,X2(10),MAXL,X3(6),CHKT,X4(24),SMAXL 006 EQU STATUS TO check;RX=check;STATUS="";IF RX THEN 007 L=DATA[2,1];CALL DKCNV(L,-1,0) 008 IF 0<=L AND L<=SMAXL THEN L=L+2-CHKT ELSE GO 9 009 END ELSE L=LEN(DATA) 010 s=0;FOR c=2 TO L 011 CHR=DATA[c,1];IF CHR="" THEN GO 9 012 s=s+SEQ(CHR) 013 NEXT c;BEGIN CASE 014 CASE CHKT=1;check=CHAR(32+MOD(INT(MOD(s,256)/64)+s,64)) 015 CASE CHKT=2 016 * Bug of some kind here; can't get it to work! 017 L=1;LOOP 018 c=MOD(s,64);CALL DKCNV(c,1,0);check=c:check 019 UNTIL L=2 DO s=INT(s/64);L=L+1 REPEAT 020 CASE CHKT=3;*Insert assembly call here 021 END CASE 022 9 RETURN 023 * * * * * Interface info * * * * * 024 *Entry: check := true if we are receiving 025 *Exit: check contains check code for packet 026 * * * * * Revision history * * * * * 027 *.0 - 4/9/87 JF3 028 END